perm filename FAI2F4.F4[P11,LCS]1 blob
sn#583813 filedate 1981-05-01 generic text, type T, neo UTF8
00100 DIMENSION I(80),JJ(10)
00200 EQUIVALENCE (I,JJ)
00300 1 FORMAT(' TYPE INPUT NAME '$)
00400 2 FORMAT(' TYPE OUTPUT NAME '$)
00500 K=80
00600 3 FORMAT(A10)
00700 4 FORMAT(A5)
00800 DOUBLE PRECISION NAM1
00900 TYPE 1
01000 ACCEPT 3,NAM1
01100 CALL DEFINE(1,NNN,0,NAM1)
01200 TYPE 2
01300 ACCEPT 4,NAM2
01400 CALL OFILE(21,NAM2)
01500 5 FORMAT(80A1)
01600 6 READ(1,5)I
01700 TYPE 5,JJ
01800 CALL SHORT(I,K)
01900 TYPE 7
02000 7 FORMAT(' START HERE? '$)
02100 ACCEPT 4,L
02150 IF(L.EQ.'Y')GO TO 10
02200 CALL WRITER(I,K)
02300 GO TO 6
02400 8 READ(1,5,END=9)I
02500 CALL SHORT(I,K)
02600 10 CALL CNVRT(I,K)
02700 IF(K.GT.0)CALL WRITER(I,K)
02800 GO TO 8
02900 9 END
03000
03100 SUBROUTINE SHORT(I,K)
03200 DIMENSION I(80)
03300 DO 3 K=80,1,-1
03400 3 IF(I(K).NE.' ')RETURN
03500 K=1
03600 END
03700
03800 SUBROUTINE CNVRT(I,K)
03900 DIMENSION I(80)
04000 4 I(1)=' '
04100 DO 10 L=2,K
04200 IF(I(L).EQ.';')GO TO 11
04300 10 CONTINUE
04400 K=-1
04450 RETURN
04500 11 N=1
04600 DO 12 M=L+1,K
04700 N=N+1
04800 12 I(N)=I(M)
04900 K=N
05000 END
05100
05200 SUBROUTINE WRITER(I,K)
05300 DIMENSION I(1)
05400 1 FORMAT(80A1)
05500 WRITE(21,1)(I(J),J=1,K)
05600 END